home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
teglp.zip
/
SAMPROGS.ZIP
/
SAMC0104.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-06-27
|
2KB
|
112 lines
{$F+} { -- far code model is required for any functions that }
{ -- are to be used as Event Handlers }
Uses
dos,
graph,
virtmem,
teglfont,
fastgrph,
TEGLIntr,
TEGLICON,
TEGLGRPH,
TEGLUnit,
TEGLMenu,
SenseMs,
DebugUnt,
TEGLEasy;
{ -- insert variables here }
VAR
om1, om2 : OptionMPtr;
{ -- insert procedures and functions here }
FUNCTION GetMsSense(FS:imagestkptr; Ms: msclickptr) : WORD;
BEGIN
SetMouseSense(fs^.x,fs^.y);
GetMsSense := 1;
END;
FUNCTION InfoOption(FS:imagestkptr; Ms: msclickptr) : WORD;
VAR
x,y,x1,y1 : word;
ifs : ImageStkPtr;
ax,ay,ax1,ay1 : word;
option : word;
BEGIN
HideMouse;
x := 200;
y := 120;
x1 := x+340;
y1 := y+100;
ax := Ms^.ms.x+FS^.x;
ay := Ms^.ms.y+FS^.y;
ax1 := Ms^.ms.x1+FS^.x;
ay1 := Ms^.ms.y1+FS^.y;
PushImage(x,y,x1,y1);
IFS := stackptr;
ZipToBox(ax,ay,ax1,ay1,x,y,x1,y1);
SetColor(White);
ShadowBox(x,y,x1,y1);
SetColor(Black);
OutTEGLtextxy(x+5,y+5,'TEGL Windows Toolkit II');
OutTEGLtextxy(x+5,y+5+TEGLCharHeight,
'Jan. 1, 1990, Program Written by Richard Tom');
PutPict(x+280,y+75,@ImageOk,Black);
DefineMouseClickArea(IFS,280,75,280+35,75+12,TRUE,
NilUnitProc,MSClick);
SetMousePosition(x+290,y+85);
ShowMouse;
WHILE CheckforMouseSelect(IFS)=NIL DO;
HideMouse;
DropStackImage(ifs);
ZipFromBox(ax,ay,ax1,ay1,ifs^.x,ifs^.y,ifs^.x1,ifs^.y1);
ShowMouse;
InfoOption := 1;
END;
BEGIN
EasyTEGL;
{ -- insert the example code here }
{ -- press Ctrl-Break to exit program }
om1 := CreateOptionMenu(@Font14);
DefineOptions(om1,' Open ', true, NilUnitProc);
DefineOptions(om1,'Info...',true, InfoOption);
DefineOptions(om1,'--', false,NilUnitProc);
DefineOptions(om1,' Quit ', true, Quit);
om2 := CreateOptionMenu(@Font14);
DefineOptions(om2,' Memory ',true,ShowCoordinates);
DefineOptions(om2,' Mouse Sensitivity ',true,GetMsSense);
CreateBarMenu(0,0,getmaxx);
OutBarOption(' File ',om1);
OutBarOption(' Utility ',om2);
{ -- control is then passed to the supervisor }
TEGLSupervisor;
END.